﻿Imports DataTool
Imports System.Net
Imports System.Net.Sockets
Imports System.Text
Imports System.Text.RegularExpressions

Public Class FrmGetHTTP
    ''' <summary>
    ''' 软件字符编码集
    ''' </summary>
    ''' <remarks></remarks>
    Private EnCode As Encoding = Encoding.GetEncoding("gb2312")

    ''' <summary>
    ''' 客户端连接对象
    ''' </summary>
    ''' <remarks></remarks>
    Private mTCPClient As TCPClientEx = Nothing

    ''' <summary>
    ''' 连接状态
    ''' </summary>
    ''' <remarks></remarks>
    Private mConn As Boolean = False
    Private mWebAddr As String '服务器域名
    Private mPageAddr As String '页面地址
    Private Sub FrmGetHTTP_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        mPageData = New List(Of Byte)(2000)
    End Sub

    Private Sub butGetHttp_Click(sender As Object, e As EventArgs) Handles butGetHttp.Click
        If Not mConn Then
            '开始准备连接
            Dim lServerPort As Long = 80
            Dim sServer As String = txtAddr.Text
            If String.IsNullOrEmpty(sServer) Then
                MsgBox("请输入正确的网页地址！", 64, "提示")
                Return
            End If



            If sServer.StartsWith("http://", StringComparison.CurrentCultureIgnoreCase) Then
                sServer = sServer.Substring(7)
            ElseIf sServer.StartsWith("https://", StringComparison.CurrentCultureIgnoreCase) Then
                MsgBox("不支持Https请求")
                Return
            End If

            '分析页面地址
            Dim iIndex = sServer.IndexOf("/")
            If iIndex = -1 Then
                mWebAddr = sServer
                mPageAddr = "/"
            Else
                mWebAddr = sServer.Substring(0, iIndex)
                mPageAddr = sServer.Substring(iIndex)
            End If
            If mWebAddr.IndexOf(":") > 0 Then
                lServerPort = Int32.Parse(mWebAddr.Substring(mWebAddr.IndexOf(":") + 1))
                mWebAddr = mWebAddr.Substring(0, mWebAddr.IndexOf(":"))
            End If
            TxtIOLog.Text = $"请求页面：{sServer}{vbNewLine}域名：{mWebAddr}{vbNewLine}页面：{mPageAddr}{vbNewLine}"
            TxtIOLog.Text = TxtIOLog.Text & New String("-", 48) & vbNewLine
            TxtIOLog.Text = TxtIOLog.Text & "开始尝试TCP连接"

            mTCPClient = New TCPClientEx(mWebAddr, lServerPort)
            AddHandler mTCPClient.OnStateChanage, AddressOf Client_OnStateChanage
            AddHandler mTCPClient.OnDataReceive, AddressOf Client_OnDataReceive
            AddHandler mTCPClient.OnSendComplete, AddressOf Client_OnSendComplete

            mTCPClient.BeginConnectEx()
        Else
            Call CloseSocket(True)

            SetDebugText("客户端关闭连接！")
        End If
    End Sub

    Private Sub ClearText()
        TxtIOLog.Text = String.Empty
        TxtHttp.Text = String.Empty

    End Sub

    Private Sub TxtIOLog_DoubleClick(sender As Object, e As EventArgs) Handles TxtIOLog.DoubleClick
        TxtIOLog.Text = String.Empty
    End Sub





    ''' <summary>
    ''' TCP状态发生变化时触发的事件
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="NowState"></param>
    ''' <remarks></remarks>
    Private Sub Client_OnStateChanage(ByVal sender As Object, ByVal NowState As TCPClientEx.SocketStateEnum)
        Dim oTCP As TCPClientEx = sender

        Select Case NowState
            Case TCPClientEx.SocketStateEnum.eErr
                SetDebugText(oTCP.ErrorCodeToString(oTCP.ErrCode))
                Call CloseSocket(oTCP)
            Case TCPClientEx.SocketStateEnum.eCloseed
                SetDebugText("服务器已关闭连接！")
                Call CloseSocket(oTCP)

            Case TCPClientEx.SocketStateEnum.eConnected
                SetDebugText("连接到服务器成功，远程服务器信息：" & oTCP.toRemoteString & "，本地连接参数：" & oTCP.toLocalString)
                SendWebGet()
            Case TCPClientEx.SocketStateEnum.eConnecting
                '输出调试信息
                SetDebugText("DNS解析完毕，解析结果：" & oTCP.toDNSString & "。")
                SetDebugText("开始尝试连接到服务器...")
            Case TCPClientEx.SocketStateEnum.eSearchDNS
                SetDebugText("开始使用DNS解析网络地址：" & oTCP.ServerAddr)
        End Select
    End Sub

    Private Sub SendWebGet()
        '发送web的Get请求
        Dim docType As String
        If mPageAddr.EndsWith("css") Then
            docType = "css"
        Else
            docType = "html"
        End If

        Dim sGet As String = $"GET {mPageAddr} HTTP/1.1
Host: {mWebAddr}
Connection: keep-alive
Accept: text/{docType}
Accept-Encoding:  deflate, sdch
User-Agent:Chrome/50.0.2661.102
Accept-Language: zh-CN,zh;q=0.8

"
        Dim b = EnCode.GetBytes(sGet)
        mHttpHead = False
        mTCPPacketCount = 0
        '异步发送  
        mTCPClient.SendEx(b, sGet)
    End Sub

    ''' <summary>
    ''' 发送指令处理完毕后的事件
    ''' </summary>
    ''' <param name="oClient"></param>
    ''' <param name="oUserPar"></param>
    ''' <param name="iSendByteCount"></param>
    ''' <param name="SendDate"></param>
    ''' <param name="SendCompleteDate"></param>
    ''' <remarks></remarks>
    Private Sub Client_OnSendComplete(ByVal oClient As TCPClientEx, ByVal oUserPar As Object, ByVal iSendByteCount As Integer, ByVal SendDate As Date, ByVal SendCompleteDate As Date)
        Dim sSend As String = String.Empty '接收到的数据明文


        If oUserPar.GetType().ToString = "System.Byte[]" Then
            Dim bData() As Byte
            bData = oUserPar

            sSend = EnCode.GetString(bData)
            sSend = oUserPar.ToString

        Else

            sSend = oUserPar
        End If


        DebugClientSend(oClient, sSend, iSendByteCount)
    End Sub


    Private mHttpHead As Boolean
    Private mHttpPageLenMax As Integer
    Private mTCPPacketCount As Integer 'tcp数据包数量
    Private mPageData As List(Of Byte)
    Private mHttpEncoding As String = String.Empty
    ''' <summary>
    ''' 有服务器指令到达的事件
    ''' </summary>
    ''' <param name="oClient"></param>
    ''' <param name="bRead"></param>
    ''' <remarks></remarks>
    Private Sub Client_OnDataReceive(ByVal oClient As TCPClientEx, ByVal bRead As Byte())
        Dim sRead As String = String.Empty '接收到的数据明文
        mTCPPacketCount += 1
        If mHttpHead = False Then
            mHttpPageLenMax = 0
            mHttpEncoding = String.Empty
            Dim sHead As String = String.Empty
            Dim iDataIndex As Integer

            '开始分析http头
            For i = 0 To bRead.Length - 1
                If bRead(i) = &HD And bRead(i + 1) = &HA And bRead(i + 2) = &HD And bRead(i + 3) = &HA Then

                    sHead = EnCode.GetString(bRead, 0, i)
                    SetDebugText($"接收到Http头,Http头长度:{sHead.Length}，内容：{vbNewLine}{sHead}")
                    iDataIndex = i + 4
                    Exit For
                End If
            Next
            If Not String.IsNullOrEmpty(sHead) Then
                mHttpHead = True
                Dim sHeadList = Regex.Split(sHead, vbNewLine, RegexOptions.IgnoreCase)
                If sHeadList(0).IndexOf("200 OK") = -1 Then
                    SetDebugText("页面返回值不正确")
                    Return
                End If
                For i = 1 To sHeadList.Length - 1
                    Dim sValues = sHeadList(i).Split(":")
                    Select Case sValues(0)
                        Case "Content-Encoding"
                            SetDebugText("页面编码格式：" & sValues(1))
                            mHttpEncoding = sValues(1)
                        Case "Content-Length"
                            SetDebugText("页面数据长度：" & sValues(1))
                            mHttpPageLenMax = sValues(1).ToInt32
                            mPageData.Clear()
                            If mPageData.Capacity < mHttpPageLenMax Then
                                mPageData.Capacity = mHttpPageLenMax
                            End If
                    End Select
                Next

                If iDataIndex = bRead.Length Then
                    Return
                Else
                    Dim iLen = bRead.Length - iDataIndex
                    mPageData.AddRange(bRead.Copy(iDataIndex, iLen))
                End If

            End If
        Else
            mPageData.AddRange(bRead)

        End If

        If mPageData.Count >= mHttpPageLenMax Then
            SetDebugText($"页面内容接收完毕：{ mPageData.Count}，接收数据包数量：{mTCPPacketCount}")
            CloseSocket(oClient) '接收完毕
            Invoke(Sub()
                       Dim b = mPageData.ToArray
                       If String.IsNullOrEmpty(mHttpEncoding) Then

                           Dim sHtml = EnCode.GetString(b)
                           If sHtml.IndexOf("utf-8") Then
                               '重新编码
                               sHtml = Encoding.UTF8.GetString(b)
                           End If
                           TxtHttp.Text = sHtml
                       Else
                           TxtHttp.Text = b.ToHex
                           Dim sHtmlAddr = mPageAddr.Split("/")
                           Dim sFileName As String = sHtmlAddr(sHtmlAddr.Length - 1)
                           IO.File.WriteAllBytes(sFileName & ".bin", b)

                           Dim iLen = b.Length
                           Dim sArrBuf = New StringBuilder(iLen * 4 + 200)
                           Dim iByteCount As Integer = 0
                           sArrBuf.AppendLine($"byte[] {sFileName}=[")
                           Dim sSplit = ","
                           For i = 0 To iLen - 1
                               sArrBuf.Append(b(i))
                               sArrBuf.Append(sSplit)
                               iByteCount += 1
                               If iByteCount = 32 Then
                                   sArrBuf.AppendLine()
                                   iByteCount = 0
                               End If
                           Next
                           sArrBuf.Length -= 1
                           sArrBuf.AppendLine()
                           sArrBuf.AppendLine("];")

                           IO.File.WriteAllText(sFileName & ".c", sArrBuf.ToString, Encoding.ASCII)
                       End If

                   End Sub)

        End If

    End Sub




    ''' <summary>
    ''' 关闭Socket
    ''' </summary>
    ''' <remarks></remarks>
    Public Sub CloseSocket(ByRef oClient As TCPClientEx)
        CloseSocket(False)
    End Sub

    ''' <summary>
    ''' 关闭Socket
    ''' </summary>
    ''' <param name="bSendCmd">指示是否在关闭连接之前往服务器发送连接关闭指令？</param>
    ''' <remarks></remarks>
    Private Sub CloseSocket(ByVal bSendCmd As Boolean)
        If mTCPClient IsNot Nothing Then
            If bSendCmd And mTCPClient.IsConnected Then
                Try
                    'mTCPClient.Sendex(EnCode.GetBytes("@@<Socket:Close>"), "CloseKey")
                Catch ex As Exception
                    Debug.Print("CloseSocket Err")
                End Try
            End If

            mTCPClient.CloseSocket()
            mTCPClient = Nothing
        End If
    End Sub




    ''' <summary>
    ''' 输出发送至客户端的内容
    ''' </summary>
    ''' <param name="oClient"></param>
    ''' <param name="sText"></param>
    ''' <param name="bytesSent"></param>
    ''' <remarks></remarks>
    Private Sub DebugClientSend(ByRef oClient As TCPClientEx, ByVal sText As String, ByVal bytesSent As Integer)
        Dim sValue As String = "发送：%1,发送字节：%2，内容：%4%3"

        sValue = ReplaceEx(sValue, {oClient.toRemoteString, bytesSent, sText, vbNewLine})
        SetDebugText(sValue)

    End Sub



    ''' <summary>
    ''' 设置输出窗口文本的委托
    ''' </summary>
    ''' <param name="text"></param>
    ''' <remarks></remarks>
    Delegate Sub SetDebugTextCallback(ByVal [text] As String)



    ''' <summary>
    ''' 设置输出窗口文本
    ''' </summary>
    ''' <param name="text"></param>
    ''' <remarks></remarks>
    Private Sub SetDebugText(ByVal [text] As String)
        If TxtIOLog.InvokeRequired Then
            Dim method As New SetDebugTextCallback(AddressOf SetDebugText)
            Invoke(method, New Object() {[text]})
        Else
            Dim sTxt As String = TxtIOLog.Text & vbNewLine & Format(Date.Now, "HH:mm:ss") & "--" & [text]
            If sTxt.Length > 20000 Then sTxt = sTxt.Substring(0.2)
            TxtIOLog.Text = sTxt
        End If
    End Sub



End Class